package Heist::Parser;

use strict;
use warnings;

use Heist::AST;

my $expression_tag_start_pattern     = quotemeta '<(';
my $code_tag_start_pattern           = quotemeta '<[';
my $code_tag_end_pattern             = quotemeta ']>';
my $code_line_start_pattern          = '^' . quotemeta ':';
my $output_stop_pattern              = quotemeta '|-';
my $output_start_pattern             = quotemeta '-|';
my $directive_start_pattern          = quotemeta '<~=';
my $method_tag_start_pattern         = quotemeta('<~') . '(?!\\=)';
my $closing_method_tag_start_pattern = quotemeta '</~';
my $identifier_pattern               = qr{ [[:alpha:]_] [[:alnum:]_]* }x;
my $suppressed_line_break_pattern    = qr{ \\ \n }x;

my %builtin_filters = (
  h => 'Heist::AST::HTMLEscapeFilter',
  u => 'Heist::AST::URIEscapeFilter',
);

=head1 NAME

Heist::Parser

=head1 DESCRIPTION

Parser for heist template files.

=head2 methods

=item new

Create a new parser.

=cut

sub new {
  my ($class) = @_;
  bless {}, $class;
}


#sub keep_original_content {
#  0;
#}

=item embedded_in_code

Returns true if the file being parsed contains template elements mixed with source code,
or false if there are only template elements.

=cut

sub embedded_in_code {
  0;
}

#sub line_offset {
#  0;
#}

=item filename

Returns the filename of the template being parsed.

=cut

sub filename {
  '';
}

=item ast_for

Returns an AST for a given template string.

Arguments:
  content - (required string) the template to parse.

=cut

sub ast_for {
  my ($this, $content) = @_;

#  $this->set_original_content($content)
#    if $this->keep_original_content;

  my $output_on = 1;

  my $embedded_in_code = $this->embedded_in_code;
  my $component;# = $this->component;
  my $root = Heist::AST::Root->new(embedded_in_code => $embedded_in_code);

  my @stack = ($root);

  pos($content) = 0;
  my $token_start = 0;
  eval {

    $embedded_in_code ? goto TOP_LEVEL : goto IN_METHOD
      unless $component;

    goto COMPONENT_NO_CODE_TOP_LEVEL
      unless $embedded_in_code;

    COMPONENT_TOP_LEVEL: {
      $content =~ m{
        \G
        (.*?)
        (?:
          ($directive_start_pattern)
        | ($method_tag_start_pattern)
        | \Z
        )
      }mogsxc or die 'could not match template';
      my $code = $1;
      push @{$stack[-1]->{subnodes}},
        Heist::AST::ContainingCode->new($code)
          if $code;
      if    (defined $-[2]) { $token_start = $-[2]; goto DIRECTIVE; }
      elsif (defined $-[3]) { $token_start = $-[3]; goto METHOD   ; }
      else { goto SUCCESS; }
    }

    TOP_LEVEL: {
      $content =~ m{
        \G
        (.*?)
        (?:
          ($method_tag_start_pattern)
        | \Z
        )
      }mogsxc or die 'could not match template';
      my $code = $1;
      push @{$stack[-1]->{subnodes}},
        Heist::ContainingCode->new($code)
          if $code;
      if (defined $-[2]) { $token_start = $-[2]; goto METHOD; }
      else { goto SUCCESS; }
    }

    COMPONENT_NO_CODE_TOP_LEVEL: {
      $content =~ m{
        \G
        (.*?)
        (?:
          ($suppressed_line_break_pattern)
        | ($code_line_start_pattern)
        | ($expression_tag_start_pattern)
        | ($code_tag_start_pattern)
        | ($output_stop_pattern)
        | ($output_start_pattern)
        | ($directive_start_pattern)
        | ($method_tag_start_pattern)
        | ($closing_method_tag_start_pattern)
        | \Z
        )
      }mogsxc or die 'could not match template';
      my $text = $1;
      push @{$stack[-1]->{subnodes}},
        $output_on ?
          Heist::AST::Content->new($text) :
          Heist::AST::IgnoredContent($text)
            if $text;
      if    (defined $-[ 2]) { $token_start = $-[ 2]; goto SUPPRESSED_LINE_BREAK; }
      elsif (defined $-[ 3]) { $token_start = $-[ 3]; goto CODE_LINE            ; }
      elsif (defined $-[ 4]) { $token_start = $-[ 4]; goto EXPRESSION_TAG_START ; }
      elsif (defined $-[ 5]) { $token_start = $-[ 5]; goto CODE_TAG_START       ; }
      elsif (defined $-[ 6]) { $token_start = $-[ 6]; goto OUTPUT_STOP          ; }
      elsif (defined $-[ 7]) { $token_start = $-[ 7]; goto OUTPUT_START         ; }
      elsif (defined $-[ 8]) { $token_start = $-[ 8]; goto DIRECTIVE            ; }
      elsif (defined $-[ 9]) { $token_start = $-[ 9]; goto METHOD               ; }
      elsif (defined $-[10]) { $token_start = $-[10]; goto METHOD_CLOSE         ; }
      else { goto SUCCESS; }
    }

    IN_METHOD: {
      $content =~ m{
        \G
        (.*?)
        (?:
          ($suppressed_line_break_pattern)
        | ($code_line_start_pattern)
        | ($expression_tag_start_pattern)
        | ($code_tag_start_pattern)
        | ($output_stop_pattern)
        | ($output_start_pattern)
        | ($method_tag_start_pattern)
        | ($closing_method_tag_start_pattern)
        | \Z
        )
      }mogsxc or die 'could not match template';
      my $text = $1;
      push @{$stack[-1]->{subnodes}},
        $output_on ?
          Heist::AST::Content->new($text) :
          Heist::AST::IgnoredContent->new($text)
            if $text;
      if    (defined $-[ 2]) { $token_start = $-[ 2]; goto SUPPRESSED_LINE_BREAK; }
      elsif (defined $-[ 3]) { $token_start = $-[ 3]; goto CODE_LINE            ; }
      elsif (defined $-[ 4]) { $token_start = $-[ 4]; goto EXPRESSION_TAG_START ; }
      elsif (defined $-[ 5]) { $token_start = $-[ 5]; goto CODE_TAG_START       ; }
      elsif (defined $-[ 6]) { $token_start = $-[ 6]; goto OUTPUT_STOP          ; }
      elsif (defined $-[ 7]) { $token_start = $-[ 7]; goto OUTPUT_START         ; }
      elsif (defined $-[ 8]) { $token_start = $-[ 8]; goto METHOD               ; }
      elsif (defined $-[ 9]) { $token_start = $-[ 9]; goto METHOD_CLOSE         ; }
      else { goto SUCCESS; }
    }

    DIRECTIVE: {
      my ($pre_ws, $directive, $mid_ws, $value, $post_ws) = $content =~ m{
        \G
        (\s*)
        (\w+)
        (\s+)
        ([^>\s]+?)
        (\s*)
        \>
      }mogsxc or die 'invalid directive';
      die "unknown directive \"$directive\"" unless $directive eq 'base';
      push @{$stack[-1]->{subnodes}},
        Heist::AST::BaseDirective->new($pre_ws, $mid_ws, $value, $post_ws);
      $component->set_base($value);
      goto COMPONENT_NO_CODE_TOP_LEVEL
        unless $embedded_in_code;
      goto COMPONENT_TOP_LEVEL;
    }

    SUPPRESSED_LINE_BREAK: {
      if ($output_on) {
        push @{$stack[-1]->{subnodes}},
          Heist::AST::SuppressedLineBreak->new;
      }
      else {
        my $last_subnode = $stack[-1]->last_subnode;
        if ($last_subnode && $last_subnode->isa('Heist::AST::IgnoredContent')) {
	  $last_subnode->text .= "\\\n";
	}
        else {
          push @{$stack[-1]->{subnodes}},
            Heist::AST::IgnoredContent->new("\\\n");
        }
      }
      goto IN_METHOD;
    }

    OUTPUT_START: {
      die "found -| output start sequence where output already on\n" if $output_on;
      $output_on = 1;
      push @{$stack[-1]->{subnodes}},
        Heist::AST::OutputStart->new;
      goto IN_METHOD;
    }

    OUTPUT_STOP: {
      die "found |- output stop sequence where output already off\n" unless $output_on;
      $output_on = 0;
      push @{$stack[-1]->{subnodes}},
        Heist::AST::OutputStop->new;
      goto IN_METHOD;
    }

    METHOD: {
      my ($pre_ws, $method_name, $pre_args_ws, $args, $pre_close_ws) =
        $content =~ m{
          \G
          (\s*)
          ($identifier_pattern)?   # optional method name
          (\s*)
          (                        # optional argument list
            \(
              [^)]*
            \)
          )?
          (\s*)
          \>
        }mogsxc or die "malformed <~...> method tag tag\n";
      my $method = Heist::AST::Method->new(
        $pre_ws,
        $method_name,
        $pre_args_ws,
        $args,
        $pre_close_ws,
      );

      push @{$stack[-1]->{subnodes}}, $method;
      push @stack, $method;

      goto IN_METHOD;
    }

    METHOD_CLOSE: {
      my ($pre_ws, $method_name, $post_ws) = $content =~ m {
        \G
        (\s*)
        ($identifier_pattern)?  # optional method name
        (\s*)
        \>
      }mogsxc or die "malformed </~...> closing method tag\n";
      $method_name ||= '';
      die "</\~$method_name> tag without corresponding <~$method_name...> tag\n"
	unless $stack[-1]->isa('Heist::AST::Method');
      die "mismatched closing tag </~$method_name> for <~" . ($stack[-1]->method_name || '') . '...> tag'
        if $method_name && ($stack[-1]->method_name || '') ne $method_name;
      pop @stack;
      if (@stack == 1) {
        $output_on = 1;
        if ($component) {
          $embedded_in_code ? goto COMPONENT_TOP_LEVEL : goto COMPONENT_NO_CODE_TOP_LEVEL;
        }
        goto TOP_LEVEL if $embedded_in_code;
      }
      goto IN_METHOD;
    }

    CODE_TAG_START: {
      $content =~ m{
        \G
        (.*?)
        $code_tag_end_pattern
      }mogsxc or die "cannot find end of code tag ']>'\n";
      my $code = $1;
      my $last_subnode = $stack[-1]->last_subnode;
      if ($last_subnode && $last_subnode->isa('Heist::AST::CodeTag')) {
        $last_subnode->code .= $code;
      }
      else {
        push @{$stack[-1]->{subnodes}}, Heist::AST::CodeTag->new($code);
      }
      goto IN_METHOD;
    }

    EXPRESSION_TAG_START: {
      $content =~ m{
        \G
        (.*?)
        \)
        (\w+(?:\,\w+)*)?
        \>
      }mogsxc or die "cannot find end of expression tag ')...>'\n";
      my $code = $1;
      my $filters = $2;
      die "empty expression tag\n"
        unless $code =~ /\S/osi;
      my @filters;
      for my $filter ($filters ? split(/\,/, $filters) : ()) {
        if ($this->filters->{$filter}) {
          push @filters, Heist::AST::UserFilter->new(
            identifier => $filter,
            method => $this->filters->{$filter},
          );
        }
        elsif ($builtin_filters{$filter}) {
          eval "require $builtin_filters{$filter}" or die;
          push @filters, $builtin_filters{$filter}->new(identifier => $filter);
        }
        else {
          die "unknown filter \"$filter\" in expression tag";
        }
      }
      push @{$stack[-1]->{subnodes}}, Heist::AST::ExpressionTag->new($code, \@filters);
      goto IN_METHOD;
    }

    CODE_LINE: {
      $content =~ m{
        \G
        ([^\r\n\f]*(?:\n|\Z))
      }mogsxc or die "cannot parse code line\n"; # again this should not come to pass
      my $code = $1;
      my $last_subnode = $stack[-1]->last_subnode;
      if ($last_subnode && $last_subnode->isa('Heist::AST::CodeLines')) {
        $last_subnode->code .= $code;
      }
      else {
        push @{$stack[-1]->{subnodes}}, Heist::AST::CodeLines->new($code);
      }
      goto IN_METHOD;
    }

    SUCCESS: {
      shift @stack or die 'no root on container stack';
      if (@stack) {
	die join(', inside ', map {
          $_->isa('Heist::AST::Method') ?
            '<~' . ($_->method_name || '') . '...> tag without corresponding </~> closing tag' :
            die 'unkown node type ' . ref($_);
        } reverse @stack) . "\n";
      }
    }
  };
  if (my $error = $@) {
    my $beginning_of_error_line = pos($content) = 0;
    my $line = 1;
    while ($content =~ m{\G[^\n\r\f]*?(?:\015\012|\012|\015)}mogsx) {
      if (pos($content) <= $token_start) {
        $line++;
        $beginning_of_error_line = pos($content);
      }
      else {
	last;
      }
    }
    #$line += $this->line_offset;
    my $character = $token_start - $beginning_of_error_line + 1;
    chomp $error;
    die "$error at " . ($this->filename ? $this->filename . ' ' : '') . "line $line, character $character";
  }
  $root;
}

1;

__END__

=back

=head1 AUTHOR

Thomas Yandell

=cut

